home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / math.swg / 0098_Vector manipulation.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-27  |  14.9 KB  |  493 lines
  1.  
  2. UNIT vector;
  3.  
  4.   (*  DESCRIPTION :
  5.      Set of 22 functions and procedures for vector ,i.e array of real
  6.      Manipulation de vecteur: 22 fonctions et procédures
  7.  
  8.      RELEASE     :  1.0
  9.      DATE        :  25/04/94
  10.      AUTHOR      :  Fernand LEMOINE
  11.                     rue du Collège 34
  12.                     B-6200 CHATELET
  13.                     BELGIQUE
  14.      All code granted to the public domain
  15.      Questions and comments are welcome
  16.      REQUIREMENT :  Turbo Pascal 7.0 or later
  17.                        *  open-string parameter
  18.                        *  constant parameter
  19.      Compatible with Borland Pascal protected mode
  20.      Compatible with Borland Pascal for Windows (Wincrt)
  21.      OPTIONS
  22.         * accept zero for computation or not accept ( default)
  23.            exceptions : VStd, VVar
  24.  
  25.         * lim = all : perform computation for all the values of the vector
  26.           otherwise lim = number of values to compute
  27.   *)
  28.  
  29. INTERFACE
  30.  
  31. CONST
  32.   all = 0;
  33.   accept_zero : Boolean = False;
  34.  
  35.   (* Clear all values - remise à zéro                                      *)
  36. PROCEDURE VClear(VAR A : ARRAY OF Real; lim : Word);
  37.   (* Display  of a vector  - Affichage d'un vecteur                        *)
  38. PROCEDURE VDisplay(CONST A : ARRAY OF Real; l, m : Byte);
  39.   (* Linear index generator - Génération d 'index                          *)
  40. PROCEDURE VIndex(VAR A : ARRAY OF Real; lim : Word);
  41.   (* Random generator - Générateur aléatoire                               *)
  42. PROCEDURE VRnd(VAR A : ARRAY OF Real; lim : Word);
  43.   (* Sum   of a vector  - Somme d'un vecteur                               *)
  44. FUNCTION VSum(CONST A : ARRAY OF Real; lim : Word) : Real;
  45.   (* Product  of a vector  - Produit d'un  vecteur                         *)
  46. FUNCTION VProd(CONST A : ARRAY OF Real; lim : Word) : Real;
  47.   (* Minimum  of a vector  - Miniimum d'un vecteur                         *)
  48. FUNCTION VMin(CONST A : ARRAY OF Real; lim : Word) : Real;
  49.   (* Average of a vector  - Moyenne d'un vecteur                           *)
  50. FUNCTION VAvg(CONST A : ARRAY OF Real; lim : Word) : Real;
  51.   (* Maximum   of a vector  - Maximum d'un vecteur                         *)
  52. FUNCTION VMax(CONST A : ARRAY OF Real; lim : Word) : Real;
  53.   (* First value of a vector  - Première valeur d'un vecteur               *)
  54. FUNCTION VFirst(CONST A : ARRAY OF Real; lim : Word) : Real;
  55.   (* Last  value of a vector  - Dernière valeur d'un vecteur               *)
  56. FUNCTION VLast(CONST A : ARRAY OF Real; lim : Word) : Real;
  57.   (* Number of values of a vector - Nombre de valeurs d'un vecteur         *)
  58. FUNCTION VSize(CONST A : ARRAY OF Real; lim : Word) : Word;
  59.  
  60.   (* Standard deviation of a vector - Ecart-type d'un vecteur              *)
  61. (* Opt = 'P' : Population
  62.          'S' : Sample     - Echantillon                                    *)
  63.  
  64. FUNCTION VStd(CONST A : ARRAY OF Real; opt : Char; lim : Word) : Real;
  65.   (* Variance of a vector  - Variance d'un vecteur                         *)
  66. (* Opt = 'P' : Population
  67.          'S' : Sample     - Echantillon                                    *)
  68. FUNCTION VVar(CONST A : ARRAY OF Real; opt : Char; lim : Word) : Real;
  69.  
  70.   (* Position of maximum     -  Position du maximum d'un vecteur           *)
  71. FUNCTION VOrdMax(CONST A : ARRAY OF Real; lim : Word) : Word;
  72.   (* Position of minimum    -  Position du minimum d'un vecteur            *)
  73. FUNCTION VOrdMin(CONST A : ARRAY OF Real; lim : Word) : Word;
  74.   (*  Subtract minimum from maximum of a vector
  75.    Différence entre maximum et minimum d'un vecteur                        *)
  76. FUNCTION VRange(CONST A : ARRAY OF Real; lim : Word) : Real;
  77.  (*  Mean between maximum and minimum of a vector
  78.    Moyenne du maximum et et du minimum d'un vecteur                        *)
  79. FUNCTION VMidRange(CONST A : ARRAY OF Real; lim : Word) : Real;
  80.  (* Median of a vector    - Médiane d'un vecteur
  81.     If not in ascending order , VMedian returns zero
  82.     Doit être trié en ordre ascendant  sinon valeur zéro
  83.   *)
  84. FUNCTION VMedian(CONST A : ARRAY OF Real; lim : Word) : Real;
  85.  
  86.   (* Reverse order   of a vector -  Retournement   d'un vecteur             *)
  87. PROCEDURE VReverse(VAR A : ARRAY OF Real; lim : Word);
  88.   (* Ascending sort of a vector -  Tri ascendant d'un vecteur               *)
  89. PROCEDURE VAscSort(VAR A : ARRAY OF Real; lim : Word);
  90.   (* Descending sort of a vector -  Tri descendant d'un vecteur              *)
  91. PROCEDURE VDescSort(VAR A : ARRAY OF Real; lim : Word);
  92.  
  93.  
  94. IMPLEMENTATION
  95. USES crt;
  96.  
  97.   FUNCTION Ascending_Order(CONST A : ARRAY OF Real; lim : Word) : Boolean;
  98.   VAR
  99.     i, limit : Word;
  100.     correct_order : Boolean;
  101.   BEGIN
  102.     correct_order := True;
  103.     IF lim = all THEN limit := high(A)
  104.     ELSE limit := lim - 1;
  105.     FOR i := 0 TO limit - 1 DO
  106.       IF A[i] > A[i + 1] THEN
  107.         correct_order := False;
  108.     Ascending_Order := correct_order;
  109.   END;
  110.     (* --------------------------------------------------------------*)
  111.   PROCEDURE VClear(VAR A : ARRAY OF Real; lim : Word);
  112.   VAR
  113.     i, limit : Word;
  114.   BEGIN
  115.     IF lim = all THEN limit := high(A)
  116.     ELSE limit := lim - 1;
  117.     FOR i := 0 TO limit DO
  118.       A[i] := 0;
  119.   END;
  120.     (* --------------------------------------------------------------*)
  121.   PROCEDURE VDisplay(CONST A : ARRAY OF Real; l, m : Byte);
  122.   VAR
  123.     i : Word;
  124.     total : Byte;
  125.   BEGIN
  126.     IF m > 0 THEN total := l + m + 1
  127.     ELSE total := l;
  128.  
  129.     FOR i := 0 TO high(A) DO
  130.     BEGIN
  131.       IF wherey >= (80 - total) THEN WriteLn;
  132.       Write(A[i]:l:m, ' ');
  133.     END;
  134.     WriteLn;
  135.   END;
  136.  
  137.     (* --------------------------------------------------------------*)
  138.   PROCEDURE VIndex(VAR A : ARRAY OF Real; lim : Word);
  139.   VAR
  140.     i, limit : Word;
  141.   BEGIN
  142.     IF lim = all THEN limit := high(A)
  143.     ELSE limit := lim - 1;
  144.     FOR i := 0 TO limit DO
  145.       A[i] := i + 1;
  146.   END;
  147.     (* --------------------------------------------------------------*)
  148.   PROCEDURE VRnd(VAR A : ARRAY OF Real; lim : Word);
  149.   VAR
  150.     i, limit : Word;
  151.   BEGIN
  152.     Randomize;
  153.     IF lim = all THEN limit := high(A)
  154.     ELSE limit := lim - 1;
  155.     FOR i := 0 TO limit DO
  156.       A[i] := Random(i);
  157.   END;
  158.     (* --------------------------------------------------------------*)
  159.   FUNCTION VSize(CONST A : ARRAY OF Real; lim : Word) : Word;
  160.   VAR
  161.     i, j, limit : Word;
  162.   BEGIN
  163.     IF lim = all THEN limit := high(A)
  164.     ELSE limit := lim - 1;
  165.     j := 0;
  166.     FOR i := 0 TO limit DO
  167.       IF (NOT accept_zero) AND (A[i] = 0) THEN continue
  168.       ELSE
  169.         Inc(j);
  170.     VSize := j;
  171.   END;
  172.     (* --------------------------------------------------------------*)
  173.   FUNCTION VSum(CONST A : ARRAY OF Real; lim : Word) : Real;
  174.   VAR
  175.     i, limit : Word;
  176.     S : Real;
  177.   BEGIN
  178.     IF lim = all THEN limit := high(A)
  179.     ELSE limit := lim - 1;
  180.     S := 0;
  181.     FOR i := 0 TO limit DO
  182.       S := S + A[i];
  183.     VSum := S;
  184.   END;
  185.  
  186.     (* --------------------------------------------------------------*)
  187.   FUNCTION VProd(CONST A : ARRAY OF Real; lim : Word) : Real;
  188.   VAR
  189.     i, limit : Word;
  190.     S : Real;
  191.   BEGIN
  192.     IF lim = all THEN limit := high(A)
  193.     ELSE limit := lim - 1;
  194.     S := 1;
  195.     FOR i := 0 TO limit DO
  196.       IF (NOT accept_zero) AND (A[i] = 0) THEN continue
  197.       ELSE
  198.         S := S * A[i];
  199.     VProd := S;
  200.   END;
  201.     (* --------------------------------------------------------------*)
  202.   FUNCTION VMin(CONST A : ARRAY OF Real; lim : Word) : Real;
  203.   VAR
  204.     i, limit : Word;
  205.     S : Real;
  206.   BEGIN
  207.     S := 1E+38;
  208.     IF lim = all THEN limit := high(A)
  209.     ELSE limit := lim - 1;
  210.     FOR i := 0 TO limit DO
  211.       IF (NOT accept_zero) AND (A[i] = 0) THEN continue
  212.       ELSE
  213.         IF A[i] < S THEN S := A[i];
  214.     VMin := S;
  215.   END;
  216.     (* --------------------------------------------------------------*)
  217.   FUNCTION VMax(CONST A : ARRAY OF Real; lim : Word) : Real;
  218.   VAR
  219.     i, limit : Word;
  220.     S : Real;
  221.   BEGIN
  222.     IF lim = all THEN limit := high(A)
  223.     ELSE limit := lim - 1;
  224.     S := A[low(A)];
  225.     FOR i := 0 TO limit DO
  226.       IF A[i] > S THEN S := A[i];
  227.     VMax := S;
  228.   END;
  229.  
  230.     (* --------------------------------------------------------------*)
  231.   FUNCTION VAvg(CONST A : ARRAY OF Real; lim : Word) : Real;
  232.   BEGIN
  233.     VAvg := VSum(A, lim) / (VSize(A, lim));
  234.   END;
  235.     (* --------------------------------------------------------------*)
  236.  
  237.   FUNCTION VFirst(CONST A : ARRAY OF Real; lim : Word) : Real;
  238.   VAR
  239.     i, limit : Word;
  240.   BEGIN
  241.     IF accept_zero THEN
  242.       VFirst := A[low(A)]
  243.     ELSE
  244.     BEGIN
  245.       IF lim = all THEN limit := high(A)
  246.       ELSE limit := lim - 1;
  247.       FOR i := 0 TO limit DO
  248.         IF A[i] <> 0 THEN
  249.         BEGIN
  250.           VFirst := A[i];
  251.           break;
  252.         END;
  253.     END;
  254.   END;
  255.     (* --------------------------------------------------------------*)
  256.  
  257.   FUNCTION VLast(CONST A : ARRAY OF Real; lim : Word) : Real;
  258.   VAR
  259.     i, limit : Word;
  260.   BEGIN
  261.     IF lim = all THEN limit := high(A)
  262.     ELSE limit := lim - 1;
  263.     IF accept_zero THEN
  264.       VLast := A[limit]
  265.     ELSE
  266.     BEGIN
  267.       FOR i := limit DOWNTO 0 DO
  268.         IF A[i] <> 0 THEN
  269.         BEGIN
  270.           VLast := A[i];
  271.           break;
  272.         END;
  273.     END;
  274.   END;
  275.  
  276.     (* --------------------------------------------------------------*)
  277.   FUNCTION VOrdMax(CONST A : ARRAY OF Real; lim : Word) : Word;
  278.   VAR
  279.     i, limit : Word;
  280.     S : Real;
  281.   BEGIN
  282.     IF lim = all THEN limit := high(A)
  283.     ELSE limit := lim - 1;
  284.     S := A[low(A)]; VOrdMax := 1;
  285.     FOR i := 0 TO limit DO
  286.       IF A[i] > S THEN
  287.       BEGIN
  288.         S := A[i];
  289.         VOrdMax := i + 1;
  290.       END;
  291.   END;
  292.    (* --------------------------------------------------------------*)
  293.  
  294.   FUNCTION VOrdMin(CONST A : ARRAY OF Real; lim : Word) : Word;
  295.   VAR
  296.     i, limit : Word;
  297.     S : Real;
  298.   BEGIN
  299.     IF lim = all THEN limit := high(A)
  300.     ELSE limit := lim - 1;
  301.     S := 1E+38; VOrdMin := 1;
  302.  
  303.     FOR i := 0 TO limit DO
  304.       IF (NOT accept_zero) AND (A[i] = 0) THEN continue
  305.       ELSE
  306.         IF A[i] < S THEN
  307.         BEGIN
  308.           S := A[i];
  309.           VOrdMin := i + 1;
  310.         END;
  311.   END;
  312.  
  313.     (* --------------------------------------------------------------*)
  314.   FUNCTION VRange(CONST A : ARRAY OF Real; lim : Word) : Real;
  315.   BEGIN
  316.     VRange := VMax(A, all) - VMin(A, all);
  317.   END;
  318.  
  319.     (* --------------------------------------------------------------*)
  320.   FUNCTION VMidRange(CONST A : ARRAY OF Real; lim : Word) : Real;
  321.   BEGIN
  322.     VMidRange := (VMax(A, all) + VMin(A, all)) / 2;
  323.   END;
  324.     (* --------------------------------------------------------------*)
  325.   FUNCTION VMedian(CONST A : ARRAY OF Real; lim : Word) : Real;
  326.   VAR
  327.     j, num : Word;
  328.   BEGIN
  329.     IF lim = all THEN num := high(A) + 1
  330.     ELSE num := lim;
  331.     IF NOT Ascending_Order(A, lim) THEN
  332.     BEGIN
  333.       VMedian := 0;
  334.       Exit;
  335.     END;
  336.  
  337.     IF Odd(num) THEN
  338.       VMedian := A[(num DIV 2)]
  339.     ELSE
  340.       VMedian := (A[(num DIV 2) - 1] + A[(num DIV 2)]) / 2.0
  341.   END;
  342.     (* --------------------------------------------------------------*)
  343.   PROCEDURE VReverse(VAR A : ARRAY OF Real; lim : Word);
  344.   VAR
  345.     i, j, limit, middle : Word;
  346.     work : Real;
  347.   BEGIN
  348.     IF lim = all THEN limit := high(A)
  349.     ELSE limit := lim - 1;
  350.     IF Odd(limit) THEN middle := (limit DIV 2) + 1
  351.     ELSE middle := limit DIV 2;
  352.     FOR i := 0 TO middle DO
  353.     BEGIN
  354.       work := A[i];
  355.       A[i] := A[limit];
  356.       A[limit] := work;
  357.       Dec(limit);
  358.     END;
  359.   END;
  360.   (* --------------------------------------------------------------*)
  361.  
  362.   PROCEDURE VAscSort(VAR A : ARRAY OF Real; lim : Word);
  363.   VAR
  364.     i, gap, limit : Word;
  365.     exchange : Boolean;
  366.     temp : Real;
  367.   BEGIN
  368.     IF lim = all THEN limit := high(A)
  369.     ELSE limit := lim - 1;
  370.     gap := limit DIV 2;
  371.     REPEAT
  372.       REPEAT
  373.         exchange := False;
  374.         FOR i := 0 TO limit - gap DO
  375.           IF A[i] > A[i + gap] THEN
  376.           BEGIN
  377.             temp := A[i];
  378.             A[i] := A[i + gap];
  379.             A[i + gap] := temp;
  380.             exchange := True;
  381.           END;
  382.       UNTIL NOT exchange;
  383.       gap := gap DIV 2;
  384.     UNTIL gap = 0;
  385.   END;
  386.   (* --------------------------------------------------------------*)
  387.  
  388.   PROCEDURE VDescSort(VAR A : ARRAY OF Real; lim : Word);
  389.   VAR
  390.     i, gap, limit : Word;
  391.     exchange : Boolean;
  392.     temp : Real;
  393.   BEGIN
  394.     IF lim = all THEN limit := high(A)
  395.     ELSE limit := lim - 1;
  396.     gap := limit DIV 2;
  397.     REPEAT
  398.       REPEAT
  399.         exchange := False;
  400.         FOR i := 0 TO limit - gap DO
  401.           IF A[i] < A[i + gap] THEN
  402.           BEGIN
  403.             temp := A[i];
  404.             A[i] := A[i + gap];
  405.             A[i + gap] := temp;
  406.             exchange := True;
  407.           END;
  408.       UNTIL NOT exchange;
  409.       gap := gap DIV 2;
  410.     UNTIL gap = 0;
  411.   END;
  412.   (* --------------------------------------------------------------*)
  413.   FUNCTION VVar(CONST A : ARRAY OF Real; opt : Char; lim : Word) : Real;
  414.   VAR
  415.     i, limit, numobs : Word;
  416.     S, vari : Real;
  417.   BEGIN
  418.     IF lim = all THEN limit := high(A)
  419.     ELSE limit := lim - 1;
  420.     numobs := limit + 1;
  421.  
  422.     S := 0.0; vari := 0.0;
  423.     FOR i := 0 TO limit DO
  424.     BEGIN
  425.       S := S + A[i];
  426.       vari := vari + Sqr(A[i]);
  427.     END;
  428.  
  429.     IF Upcase(opt) = 'S' THEN
  430.       VVar := (vari - Sqr(S) / numobs) / (numobs - 1)
  431.     ELSE
  432.       VVar := (vari - Sqr(S) / numobs) / numobs;
  433.   END;
  434.   (* --------------------------------------------------------------*)
  435.  
  436.   FUNCTION VStd(CONST A : ARRAY OF Real; opt : Char; lim : Word) : Real;
  437.   BEGIN
  438.     VStd := Sqrt(VVar(A, opt, lim));
  439.   END;
  440.   (* --------------------------------------------------------------*)
  441. END.
  442.  
  443. { ----------------   DEMO PROGRAM   ------------------ }
  444.  
  445. program demovect;
  446. uses crt,vector;
  447.  
  448. const
  449.  A : array[1..6] of real = (45,26,184,2,0,86);
  450. var
  451.  B : array[1..5] of real;
  452.  
  453.  begin
  454.    clrscr;Writeln('Demo vector unit');
  455.    VDisplay(A,3,0);
  456.  
  457.    VAscSort(A,all);
  458.    VDisplay (A,3,0);
  459.    VDescSort(A,all);
  460.    VDisplay (A,3,0);
  461.  
  462.    VIndex(B,all);
  463.    VDisplay (B,3,0);
  464.    VReverse(B,all);
  465.    VDisplay (B,3,0);
  466.    VClear(B,all);
  467.    VRnd(B,all);
  468.  
  469. (*   accept_zero := true;  *)    {   <----------- can be modified }
  470.  
  471.    writeln('Size         ',VSize(A,all):3);
  472.    writeln('Product      ',VProd(A,all):5:0);
  473.    writeln('Sum          ',VSum (A,all):5:0);
  474.    writeln('Average      ',VAvg (A,all):5:2);
  475.    writeln('Maximum      ',VMax (A,all):5:0);
  476.    writeln('Maximum    4 ',VMax (A,4):5:0);
  477.    writeln('Minimum      ',VMin (A,all):5:0);
  478.    writeln('First value  ',VFirst(A,all):5:0);
  479.    writeln('Last  value  ',VLast(A,all):5:0);
  480.    writeln('Last value 4 ',VLast(A,4):5:0);
  481.  
  482.    writeln('Ord  max     ',VOrdMax(A,all):3);
  483.    writeln('Ord  min     ',VOrdMin(A,all):3);
  484.    writeln('Range        ',VRange (A,all):3:2);
  485.    writeln('Midrange     ',VMidRange(A,all):3:2);
  486.    VAscSort(A,all);
  487.    writeln('Median all   ',VMedian(A,all):5:2);
  488.    writeln('Median 4     ',VMedian(A,4):5:2);
  489.    writeln('Variance     ',VVar(A,'S',all):5:2);
  490.    writeln('St deviation ',VStd(A,'S',all):5:2);
  491.    delay(3500);
  492.  
  493.   end.